home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 04 - 1988 / 04.02 Feb 88 / pascal sources / Plot Project Stuff / solve < prev   
Encoding:
Text File  |  1988-01-09  |  9.0 KB  |  379 lines  |  [TEXT/PJMM]
  1. UNIT solve;
  2.  
  3. INTERFACE
  4.  
  5.     USES
  6.         ROM85, PrintTraps, PlotGlobals, Misc;
  7.  
  8.     PROCEDURE quad (a, b, c : real;
  9.                                     VAR x1, x2 : real;
  10.                                     VAR result : integer);
  11.  
  12.     FUNCTION solveit : integer;
  13.     PROCEDURE doPlot;
  14.     PROCEDURE PrQDStuff (pRect : rect;
  15.                                     QDdevice : integer);
  16.  
  17. IMPLEMENTATION
  18.  
  19.     FUNCTION positivecalc (a, b, check : real) : real;
  20.     BEGIN
  21.         positivecalc := (-b + sqrt(check)) / (2 * a);
  22.     END;
  23.  
  24.     FUNCTION negativecalc (a, b, check : real) : real;
  25.     BEGIN
  26.         negativecalc := (-b - sqrt(check)) / (2 * a);
  27.     END;
  28.  
  29.     PROCEDURE doDialog;
  30.         VAR
  31.             dialogP : DialogPtr;
  32.             item : integer;
  33.             dtype : integer;
  34.             ditem : handle;
  35.             drect : rect;
  36.             dtext : Str255;
  37.     BEGIN
  38.         dialogP := GetNewDialog(ParamDialog, NIL, pointer(-1));
  39.         IF dialogP = NIL THEN
  40.             BEGIN
  41.                 doMessage('Dialog crash!', 'We are dead...', '', '');
  42.                 ExitToShell;
  43.             END;
  44.         initCursor;
  45.         IF dialogflg THEN
  46.             BEGIN
  47.                 dtext := StringOf(a : 4 : 1);
  48.                 GetDItem(dialogP, dA, dtype, ditem, drect);
  49.                 SetIText(ditem, dtext);
  50.                 dtext := StringOf(b : 4 : 1);
  51.                 GetDItem(dialogP, dB, dtype, ditem, drect);
  52.                 SetIText(ditem, dtext);
  53.                 dtext := StringOf(c : 4 : 1);
  54.                 GetDItem(dialogP, dC, dtype, ditem, drect);
  55.                 SetIText(ditem, dtext);
  56.                 dtext := StringOf(step : 5 : 3);
  57.                 GetDItem(dialogP, dSTEP, dtype, ditem, drect);
  58.                 SetIText(ditem, dtext);
  59.                 dtext := StringOf(xscale);
  60.                 GetDItem(dialogP, dXSCALE, dtype, ditem, drect);
  61.                 SetIText(ditem, dtext);
  62.                 dtext := StringOf(yscale);
  63.                 GetDItem(dialogP, dYSCALE, dtype, ditem, drect);
  64.                 SetIText(ditem, dtext);
  65.             END;
  66.         REPEAT
  67.             ModalDialog(NIL, item);
  68.         UNTIL item = dOK;
  69.         GetDItem(dialogP, dA, dtype, ditem, drect);
  70.         GetIText(ditem, dtext);
  71.         ReadString(dtext, a);
  72.         GetDItem(dialogP, dB, dtype, ditem, drect);
  73.         GetIText(ditem, dtext);
  74.         ReadString(dtext, b);
  75.         GetDItem(dialogP, dC, dtype, ditem, drect);
  76.         GetIText(ditem, dtext);
  77.         ReadString(dtext, c);
  78.         GetDItem(dialogP, dSTEP, dtype, ditem, drect);
  79.         GetIText(ditem, dtext);
  80.         ReadString(dtext, step);
  81.         GetDItem(dialogP, dXSCALE, dtype, ditem, drect);
  82.         GetIText(ditem, dtext);
  83.         ReadString(dtext, xscale);
  84.         GetDItem(dialogP, dYSCALE, dtype, ditem, drect);
  85.         GetIText(ditem, dtext);
  86.         ReadString(dtext, yscale);
  87.         PlotDocHandle^^.aParam := a;
  88.         PlotDocHandle^^.bParam := b;
  89.         PlotDocHandle^^.cParam := c;
  90.         PlotDocHandle^^.stepParam := step;
  91.         PlotDocHandle^^.xParam := xscale;
  92.         PlotDocHandle^^.yParam := yscale;
  93.         dialogflg := true;
  94.         DisposDialog(dialogP);
  95.     END;
  96.  
  97.     PROCEDURE quad; {(a, b, c : real;var x1, x2 : real;var result : integer);}
  98.         VAR
  99.             check : real;
  100.     BEGIN
  101.         result := 0;
  102.         check := (b * b) - (4 * a * c);
  103.         IF result = 0 THEN
  104.             BEGIN
  105.          { Check if double root exists }
  106.                 IF check = 0 THEN
  107.                     BEGIN
  108.                         result := 2;
  109.                         x1 := positivecalc(a, b, check);
  110.                         x2 := x1;
  111.                     END;
  112.         { Check if real result}
  113.                 IF check > 0 THEN
  114.                     BEGIN
  115.                         result := 1;
  116.                         x1 := positivecalc(a, b, check);
  117.                         x2 := negativecalc(a, b, check);
  118.                     END;
  119.         { Check if root is complex }
  120.                 IF check < 0 THEN
  121.                     BEGIN
  122.                         result := 3;
  123.                         check := -check;
  124.                         x1 := positivecalc(a, b, check);
  125.                         x2 := negativecalc(a, b, check);
  126.                     END;
  127.             END;
  128.     END;
  129.  
  130.     PROCEDURE PrQDStuff; {(pRect : rect; QDdevice : integer);}
  131.         CONST
  132.             Display = 1;
  133.             LaserWriter = 2;
  134.             ImageWriter = 3;
  135.             NoJust = 0;
  136.             LeftJust = 1;
  137.             CenterJust = 2;
  138.             RightJust = 3;
  139.             FullJust = 4;
  140.             LinesInParagraph = 5;
  141.     {selected MacDraw comments}
  142.             picDwgBeg = 130;
  143.             picDwgEnd = 131;
  144.             picGrpBeg = 140;
  145.             picGrpEnd = 141;
  146.             TextBegin = 150;
  147.             TextEnd = 151;
  148.             StringBegin = 151;
  149.             StringEnd = 153;
  150.             TextCenter = 154;
  151.     {postscript comments}
  152.             SetLineWidth = 182;
  153.             PostScriptBegin = 190;
  154.             TextIsPostscript = 194;
  155.             PostScriptEnd = 191;
  156.         TYPE
  157.             widhdl = ^widptr;
  158.             widptr = ^widpt;
  159.             widpt = Point;
  160.  
  161.             TTxtPicRec = PACKED RECORD
  162.                     tJus : Byte;
  163.                     tFlip : Byte;
  164.                     tRot : Integer;
  165.                     tLine : Byte;
  166.                     tCmnt : Byte;
  167.                 END;
  168.  
  169.         VAR
  170.             le, tp, ri, bo : integer;
  171.             str1, str2, str3, str4, str5 : str255;
  172.             str6, str7, str8, str9 : str255;
  173.             hPos, vPos, hor, ver : integer;
  174.             x, y, z1, z2 : real;
  175.             rBox, ClipBox : rect;
  176.             Width : Widhdl;
  177.             leading : integer;
  178.             LineNo : integer;
  179.             ParagraphBegin : Point;
  180.             Indent : integer;
  181.             Paragraph : ARRAY[1..LinesInParagraph] OF str255;
  182.             TxtPicRec : TTxtPicRec;
  183.             TxtPicPtr : QDPtr;
  184.             TxtPicHdl : QDHandle;
  185.             TextClipRgn : RgnHandle;
  186.             SaveClip : RgnHandle;
  187.             fInfo : FontInfo;
  188.     BEGIN
  189.         SaveClip := NewRgn;
  190.         GetClip(SaveClip);
  191.         ClipRect(pRect);
  192.         TextClipRgn := NewRgn;
  193.         penNormal;
  194.         IF QDdevice = LaserWriter THEN
  195.             BEGIN
  196.                 TextFont(times);
  197.                 TextSize(10);
  198.                 TextFace([]);
  199.                 TextMode(srcOr);
  200.             END;
  201.         hor := (pRect.right - pRect.left) DIV 2;
  202.         ver := (pRect.bottom - pRect.top) DIV 2;
  203.         Width := Widhdl(NewHandle(sizeof(widpt)));
  204.         Width^^.h := 10;
  205.         Width^^.v := 1;
  206.         TxtPicPtr := @TxtPicRec;
  207.         TxtPicHdl := @TxtPicPtr;
  208.         TxtPicRec.tJus := LeftJust;
  209.         TxtPicRec.tFlip := 0; {no flip}
  210.         TxtPicRec.tRot := 0; {no rotation}
  211.         TxtPicRec.tLine := 2; {1 1/2 spacing}
  212.         GetFontInfo(fInfo);
  213.         leading := fInfo.descent + fInfo.ascent + fInfo.leading;
  214.         Indent := 2;
  215.         x := -xscale / 2;
  216.         y := a * x * x + (b * x) + c;
  217.         hPos := integer(round(x * hor * 2 / xscale + hor));
  218.         vPos := integer(round(-y * ver * 2 / yscale + ver));
  219.         z1 := -b / (2 * a);
  220.         z2 := (4 * a * c - (b * b)) / (4 * a);
  221.         le := 2;
  222.         tp := ver + (ver DIV 3);
  223.         ri := 140;
  224.         IF ri >= (hor + hor DIV 3) THEN
  225.             ri := hor + hor DIV 3;
  226.         bo := ver + ver - 2;
  227.         setRect(rBox, le, tp - 14, ri, bo);
  228.         ParagraphBegin.h := 4;
  229.         ParagraphBegin.v := tp;
  230.  
  231. {Graph Text}
  232.         str1 := stringOf(-xscale DIV 2);
  233.         str2 := stringOf(yscale DIV 2);
  234.         str3 := stringOf(xscale DIV 2);
  235.         str4 := stringOf(-yscale DIV 2);
  236.  
  237.         Paragraph[1] := StringOf('y=ax^2 + bx + c', chr(13));
  238.         Paragraph[2] := StringOf('a=', a : 3 : 1, ', b=', b : 3 : 1, ', c=', c : 3 : 1, chr(13));
  239.         Paragraph[3] := StringOf('x1=', x1 : 5 : 3, ', x2=', x2 : 5 : 3, chr(13));
  240.         CASE result OF
  241.             1 : 
  242.                 Paragraph[4] := StringOf('Two Real Roots, x1, x2', chr(13));
  243.             2 : 
  244.                 Paragraph[4] := StringOf('Double Root', chr(13));
  245.             3 : 
  246.                 Paragraph[4] := StringOf('Two Complex Roots ', chr(13));
  247.             OTHERWISE
  248.                 ;
  249.         END;
  250.         Paragraph[5] := StringOf('Slope 0 = (', z1 : 2 : 1, ',', z2 : 2 : 1, ')', chr(13));
  251.  
  252.         PenNormal;
  253.         BackColor(Color[BackgroundColor]);
  254.         ForeColor(Color[AxisColor]);
  255.  
  256. {Drawing Boundry}
  257.         PicComment(picDwgBeg, 0, NIL); {Begin MacDraw Document}
  258.         PicComment(picGrpBeg, 0, NIL);
  259.         PicComment(SetLineWidth, 2, Handle(Width));
  260.         IF QDdevice = Display THEN
  261.             FillRect(pRect, white);
  262.         FrameRect(pRect);
  263.  
  264. {Two Axis}
  265.         PicComment(picGrpBeg, 0, NIL);
  266.         moveto(0, ver);
  267.         line(hor + hor, 0);
  268.         moveto(hor, 0);
  269.         line(0, ver + ver);
  270.         PicComment(picGrpEnd, 0, NIL);
  271.  
  272.         ForeColor(Color[GraphColor]);
  273.  
  274. {Plot Itsef}
  275.         PicComment(picGrpBeg, 0, NIL);
  276.         moveto(hPos, vPos);
  277.         REPEAT
  278.             x := x + step;
  279.             y := a * x * x + (b * x) + c;
  280.             hPos := integer(round(x * hor * 2 / xscale + hor));
  281.             vPos := integer(round(-y * ver * 2 / yscale + ver));
  282.             WITH pRect DO
  283.                 IF (hPos < right) AND (hPos > left) AND (vPos < bottom) AND (vPos > top) THEN
  284.                     LineTo(hPos, vPos)
  285.                 ELSE
  286.                     moveto(hPos, vPos);
  287.         UNTIL x >= xscale / 2;
  288.         PicComment(picGrpEnd, 0, NIL);
  289.  
  290.         ForeColor(Color[1]);
  291.  
  292. {Axis Text}
  293.         moveto(4, ver + 14);
  294.         DrawString(str1);
  295.         moveto(hor - 40, 14);
  296.         DrawString(str2);
  297.         moveto(hor + hor - 50, ver + 14);
  298.         DrawString(str3);
  299.         moveto(hor - 40, ver + ver - 14);
  300.         DrawString(str4);
  301.  
  302. {Box }
  303.         PicComment(picGrpBeg, 0, NIL);
  304.         PicComment(picGrpBeg, 0, NIL);
  305.         PicComment(SetLineWidth, 2, Handle(Width));
  306.         IF QDdevice = Display THEN
  307.             fillRect(rBox, white);
  308.         frameRect(rBox);
  309.         PicComment(picGrpEnd, 0, NIL); {of box}
  310.  
  311.         GetClip(TextClipRgn);
  312.         ClipBox := rBox;
  313.         ClipRect(ClipBox);
  314.  
  315.     {Box Text}
  316.         PicComment(TextBegin, sizeof(TTxtPicRec), Handle(TxtPicHdl));
  317.         FOR LineNo := 1 TO LinesInParagraph DO
  318.             BEGIN
  319.                 moveto(ParagraphBegin.h, ParagraphBegin.v);
  320.                 move(Indent, (LineNo - 1) * leading);
  321.                 DrawString(Paragraph[LineNo]);
  322.             END;
  323.         PicComment(TextEnd, 0, NIL);
  324.         PicComment(PicGrpEnd, 0, NIL); {of Box & text}
  325.         PicComment(PicGrpEnd, 0, NIL); {of select all objects}
  326.         picComment(picDwgEnd, 0, NIL); {of drawing}
  327.  
  328.         SetClip(SaveClip);
  329.         disposHandle(handle(width));
  330.         DisposeRgn(TextClipRgn);
  331.         DisposeRgn(SaveClip);
  332.     END;
  333.  
  334.     PROCEDURE PlotMe;
  335.         CONST
  336.             Display = 1;
  337.         VAR
  338.             Displayrect : rect;
  339.             pstate : PenState;
  340.     BEGIN
  341.         Displayrect := PicRect;
  342.         IF PlotDocHandle^^.drawing <> NIL THEN
  343.             BEGIN
  344.                 KillPicture(DrawingPic);
  345.                 PlotDocHandle^^.drawing := NIL;
  346.             END;
  347.         GetPenState(pstate);
  348.         DrawingPic := OpenPicture(Displayrect);
  349.         PrQDStuff(Displayrect, Display);
  350.         ClosePicture;
  351.         SetPenState(pstate);
  352.         InvalRect(Displayrect); {draw picture}
  353.         PlotDocHandle^^.drawing := DrawingPic; {save it}
  354.     END;
  355.  
  356.     FUNCTION solveit; { : integer;}
  357.     BEGIN
  358.         doDialog;
  359.         IF a <> 0 THEN
  360.             quad(a, b, c, x1, x2, result)
  361.         ELSE
  362.             result := -1;
  363.         solveit := result;
  364.     END;
  365.  
  366.     PROCEDURE doPlot;
  367.     BEGIN
  368.         result := solveit;
  369.         showWindow(PlotWindow);
  370.         IF PlotWindow <> FrontWindow THEN
  371.             SelectWindow(PlotWindow);
  372.         IF result <> -1 THEN
  373.             BEGIN
  374.                 PlotMe;
  375.                 EnableItem(myMenus[FileM], fPrint);
  376.             END;
  377.     END;
  378.  
  379. END.